unit Unit19;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, IBQuery,
  IBDatabase;

type

  { TForm19 }

  TForm19 = class(TForm)
    ibq1: TIBQuery;
    ibt1: TIBTransaction;
    procedure FormCreate(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

  TDokumentType = (dtPrzychod, dtRozchod);

// a  Table nazwa tabeli
// st Lista stringow
procedure FillStrings(ibq: TIBQuery; aTable: string; st: TStrings);
function  GetIdx(txt: string): integer;
function IsFloat(txt : string):boolean;
procedure GetNextDokNr(sgn: string; var id :integer; var numer : string);


var
  Form19: TForm19;
  ibq1  : TIBQuery;
  ibt1  : TIBTransaction;

implementation

procedure FillStrings(ibq: TIBQuery; aTable: string; st: TStrings);
begin
  if ibq.Transaction.Active then ibq.Transaction.Rollback;
  ibq.SQL.Clear;
  ibq.SQL.Add('select nazwadl,'+aTable+'_idx from '+aTable+' order by Upper(nazwadl)');
  try
    ibq.Transaction.StartTransaction;
    ibq.Open;

    st.Clear;
    ibq.First;
    while not ibq.EOF do
    begin
      st.Add(ibq.FieldByName('nazwadl').AsString+' ('+ibq.FieldByName(aTable+'_idx').AsString+')');
      ibq.Next;
    end;

    ibq.Transaction.Commit;
  except
    ibq.Transaction.Rollback;
  end;

end;

function GetIdx(txt: string): integer;
var
  buf : string;
begin
  buf:='';
  while (txt <> '') and (txt[length(txt)] <> '(') do
  begin
    delete(txt,length(txt),1);
    while (txt <> '') and (txt[length(txt)] in ['0'..'9']) do
    begin
      buf:=txt[length(txt)]+buf;
      delete(txt,length(txt),1);
    end;
  end;
  if buf = '' then GetIdx:=0 else GetIdx:=StrToInt(buf);
end;

function IsFloat(txt : string):boolean;
var
  i : integer;
begin
  IsFloat:=false;
  if trim(txt) = '' then exit;
  for i:=1 to length(txt) do if not (txt[i] in ['0'..'9',',','-']) then exit;
  IsFloat:=true;
end;

// procedura zwraca koleny numer dla wybranej sygnatury dokumentu
// uwzgledniając aktualny rok pobrany z serwera sql.
procedure GetNextDokNr(sgn: string; var id :integer; var numer : string);
var
  year : word;
  nr   : integer;
begin
  id:=-1;
  numer:='';
  year:=-1;

  // pobranie aktualnego roku z serwera sql
  if ibt1.Active then ibt1.Rollback;
  ibq1.SQL.Clear;
  ibq1.SQL.Add('select extract(year from cast(''Now'' as date)) from rdb$database');
  try
    ibt1.StartTransaction;
    ibq1.Open;
    if ibq1.RecordCount <> 0 then year:=ibq1.Fields[0].AsInteger;
    ibt1.Commit;
  except
    ibt1.Rollback;
  end;

  if year = -1 then exit;

  if ibt1.Active then ibt1.Rollback;
  ibq1.SQL.Clear;
  ibq1.SQL.Add('select * from defdok where Upper(sygnatura) = :a');
  ibq1.ParamByName('a').AsString:=UpperCase(trim(sgn));
  try
    ibt1.StartTransaction;
    ibq1.Open;
    if ibq1.RecordCount <> 0 then
    begin
      id:=ibq1.FieldByName('defdok_idx').AsInteger;
      ibq1.Close;
      ibq1.SQL.Clear;
      ibq1.SQL.Add('select * from numery where defdok_idx = :a and rok = :b');
      ibq1.ParamByName('a').AsInteger:=id;
      ibq1.ParamByName('b').AsInteger:=year;
      ibq1.Open;
      if ibq1.RecordCount = 0 then // jesli brak to pierwszy dokument w danym roku - dodaj rekord
      begin
        nr:=1;
        ibq1.Close;
        ibq1.SQL.Clear;
        ibq1.SQL.Add('insert into numery (numer, rok, defdok_idx) values ( :a, :b, :c )');
        ibq1.ParamByName('a').AsInteger:=1;
        ibq1.ParamByName('b').AsInteger:=year;
        ibq1.ParamByName('c').AsInteger:=id;
        ibq1.ExecSQL;
      end
      else // numeracja w roku juz istnieje - powiekrz o 1 i zwroc wynik
      begin
        nr:=ibq1.FieldByName('numer').AsInteger+1;
        ibq1.Close;
        ibq1.SQL.Clear;
        ibq1.SQL.Add('update numery set numer = '+IntToStr(nr)+' where defdok_idx = :a and rok = :b');
        ibq1.ParamByName('a').AsInteger:=id;
        ibq1.ParamByName('b').AsInteger:=year;
        ibq1.ExecSQL;
      end;

      numer:=IntToStr(nr)+'/'+IntToStr(year);
    end;
    ibt1.Commit;
  except
    ibt1.Rollback;
  end;
end;


{ TForm19 }

procedure TForm19.FormCreate(Sender: TObject);
begin

end;

{$R *.lfm}

end.

